home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / c / genmo112.lha / GTB-Modula / GenModula / GenerateMenus.mod < prev    next >
Encoding:
Modula Implementation  |  1993-09-28  |  8.4 KB  |  340 lines
  1. IMPLEMENTATION MODULE GenerateMenus;
  2.  
  3. (*
  4.  * -------------------------------------------------------------------------
  5.  *
  6.  *    :Program.    GenModula
  7.  *    :Contents.    A Modula 2 Sourcecode generator for GadToolsBox
  8.  *
  9.  *    :Author.    Reiner B. Nix
  10.  *    :Address.    Geranienhof 2, 50769 Köln Seeberg
  11.  *    :Address.    rbnix@pool.informatik.rwth-aachen.de
  12.  *    :Copyright.    Reiner B. Nix
  13.  *    :Language.    Modula-2
  14.  *    :Translator.    M2Amiga A-L V4.2d
  15.  *    :Imports.    GadToolsBox, NoFrag  by Jaan van den Baard
  16.  *    :Imports.    InOut, NewArgSupport by Reiner Nix
  17.  *    :History.    this programm is a direct descendend from
  18.  *    :History.     OG (Oberon Generator) 37.11 by Thomas Igracki, Kai Bolay
  19.  *    :History.    GenModula 1.10 (23.Aug.93)    ;M2Amiga 4.0d
  20.  *    :History.    GenModula 1.12 (28.Sep.93)    ;M2Amiga 4.2d
  21.  *
  22.  * -------------------------------------------------------------------------
  23.  *)
  24.  
  25. FROM    SYSTEM            IMPORT    LONGSET;
  26. FROM    String            IMPORT    Length;
  27. FROM    FileOut            IMPORT    Write, WriteString, WriteLn,
  28.                     WriteCard, WriteInt, WriteHex;
  29. FROM    IntuitionD        IMPORT    MenuItemFlags, MenuItemFlagSet;
  30. FROM    GadToolsD        IMPORT    nmTitle, nmItem, nmSub, nmEnd,
  31.                     nmBarlabel;
  32. FROM    GadToolsBox        IMPORT    ExtNewMenu,
  33.                     ExtNewMenuPtr, ProjectWindowPtr;
  34. FROM    GeneratorIO        IMPORT    dfile, mfile, args,
  35.                     Gui, MainConfig, CConfig, Projects,
  36.                     WriteFill, SeekBack;
  37.  
  38.  
  39. PROCEDURE WriteMenuConsts    (    pw            :ProjectWindowPtr);
  40.  
  41. VAR    i            :CARDINAL;
  42.     menu, item, sub        :ExtNewMenuPtr;
  43.  
  44.  
  45.   PROCEDURE WriteNewMenuConsts    (    menu        :ExtNewMenu;
  46.                        projectName    :ARRAY OF CHAR;
  47.                        number        :CARDINAL);
  48.  
  49.   BEGIN
  50.   IF menu.menuLabel[0] # 0C THEN
  51.     Write       (dfile, "\t");
  52.     WriteString (dfile, projectName);
  53.     WriteString (dfile, "Menu");
  54.     WriteString (dfile, menu.menuLabel);
  55.     WriteString (dfile, "ID");
  56.     WriteFill   (dfile, menu.menuLabel, Length (projectName)+6);
  57.     WriteString (dfile, "=");
  58.     WriteCard   (dfile, number, 3);
  59.     Write       (dfile, ";");
  60.     WriteLn (dfile)
  61.     END
  62.   END WriteNewMenuConsts;
  63.  
  64.  
  65. (* WriteMenuConsts *)
  66. BEGIN
  67. menu := pw^.menus.head;
  68.  
  69. IF menu^.succ # NIL THEN
  70.   i := 0;
  71.   menu := pw^.menus.head;
  72.   WHILE menu^.succ # NIL DO
  73.     INC (i);
  74.     WriteNewMenuConsts (menu^, pw^.name, i);
  75.  
  76.     item := menu^.items^.head;
  77.     WHILE item^.succ # NIL DO
  78.       INC (i);
  79.       WriteNewMenuConsts (item^, pw^.name, i);
  80.  
  81.       sub := item^.items^.head;
  82.       WHILE sub^.succ # NIL DO
  83.         INC (i);
  84.         WriteNewMenuConsts (sub^, pw^.name, i);
  85.  
  86.         sub := sub^.succ
  87.         END;
  88.  
  89.       item := item^.succ;
  90.       END;
  91.  
  92.     menu := menu^.succ
  93.     END;
  94.  
  95.   WriteLn (dfile);
  96.   END
  97. END WriteMenuConsts;
  98.  
  99.  
  100. PROCEDURE WriteMenuDefs        (    pw            :ProjectWindowPtr);
  101.  
  102. VAR    recordNumber        :CARDINAL;
  103.     menu, item, sub        :ExtNewMenuPtr;
  104.  
  105. BEGIN
  106. menu := pw^.menus.head;
  107. IF menu^.succ # NIL THEN
  108.   recordNumber := 0;
  109.  
  110.   WHILE menu^.succ # NIL DO
  111.     INC (recordNumber);
  112.  
  113.     item := menu^.items^.head;
  114.     WHILE item^.succ # NIL DO
  115.       INC (recordNumber);
  116.  
  117.       sub := item^.items^.head;
  118.       WHILE sub^.succ # NIL DO
  119.         INC (recordNumber);
  120.  
  121.         sub := sub^.succ
  122.         END;
  123.  
  124.       item := item^.succ;
  125.       END;
  126.  
  127.     menu := menu^.succ
  128.     END;
  129.  
  130.  
  131.   WriteString (mfile, "\t");
  132.   WriteString (mfile, pw^.name);
  133.   WriteString (mfile, "MenuStrip");
  134.   WriteFill   (mfile, pw^.name, 9);
  135.   WriteString (mfile, ":MenuPtr;");
  136.   WriteLn (mfile);
  137.  
  138.   WriteString (mfile, "\t");
  139.   WriteString (mfile, pw^.name);
  140.   WriteString (mfile, "Menu");
  141.   WriteFill   (mfile, pw^.name, 4);
  142.   WriteString (mfile, ":ARRAY [1..");
  143.   WriteCard   (mfile, recordNumber+1, 1);
  144.   WriteString (mfile, "] OF NewMenu;");
  145.   WriteLn (mfile)
  146.   END
  147. END WriteMenuDefs;
  148.  
  149.  
  150.  
  151. PROCEDURE WriteMenuProcs    (    pw            :ProjectWindowPtr);
  152.  
  153.  
  154.   PROCEDURE WriteMenuInit    (    pw            :ProjectWindowPtr);
  155.  
  156.   VAR    i            :CARDINAL;
  157.       menu, item, sub        :ExtNewMenuPtr;
  158.  
  159.  
  160.     PROCEDURE WriteNewMenuInit    (    menu        :ExtNewMenu;
  161.                          projectName    :ARRAY OF CHAR;
  162.                          number        :CARDINAL);
  163.  
  164.     VAR    i            :CARDINAL;
  165.  
  166.     BEGIN
  167.     WriteString (mfile, "WITH ");
  168.     WriteString (mfile, projectName);
  169.     WriteString (mfile, "Menu[");
  170.     WriteCard   (mfile, number, 3);
  171.     WriteString (mfile, "] DO");
  172.     WriteLn (mfile);
  173.  
  174.     WriteString (mfile, "  type          := ");
  175.     CASE menu.newMenu.type OF
  176.     | nmTitle: WriteString (mfile, "nmTitle;"); WriteLn (mfile);
  177.     | nmItem:  WriteString (mfile, "nmItem;");  WriteLn (mfile);
  178.     | nmSub:   WriteString (mfile, "nmSub;");   WriteLn (mfile);
  179.       END;
  180.  
  181.     WriteString (mfile, "  label         := ");
  182.     IF menu.newMenu.label = nmBarlabel THEN
  183.       WriteString (mfile, "nmBarlabel;");
  184.       WriteLn (mfile)
  185.     ELSE
  186.       WriteString (mfile, "ADR ('");
  187.       WriteString (mfile, menu.menuTitle);
  188.       WriteString (mfile, "');");
  189.       WriteLn (mfile)
  190.       END;
  191.  
  192.     WriteString (mfile, "  commKey       := ");
  193.     IF menu.newMenu.commKey = NIL THEN
  194.       WriteString (mfile, "NIL;");
  195.       WriteLn (mfile)
  196.     ELSE
  197.       WriteString (mfile, "ADR ('");
  198.       WriteString (mfile, menu.commKey);
  199.       WriteString (mfile, "\\000');");
  200.       WriteLn (mfile)
  201.       END;
  202.  
  203.     WriteString (mfile, "  itemFlags     := MenuItemFlagSet {");
  204.     WITH menu.newMenu DO
  205.       IF checkIt IN itemFlags THEN
  206.         WriteString (mfile, "checkIt,")
  207.         END;
  208.       IF menuToggle IN itemFlags THEN
  209.         WriteString (mfile, "menuToggle,")
  210.         END;
  211.       IF itemEnabled IN itemFlags THEN
  212.         WriteString (mfile, "itemEnabled,")
  213.         END;
  214.       IF checked IN itemFlags THEN
  215.         WriteString (mfile, "checked,")
  216.         END;
  217.       IF itemFlags # MenuItemFlagSet {} THEN
  218.         SeekBack (mfile, 1)
  219.         END
  220.       END;
  221.     WriteString (mfile, "};");
  222.     WriteLn (mfile);
  223.  
  224.     WriteString (mfile, "  mutualExclude := LONGSET {");
  225.     FOR i := 0 TO 31 DO
  226.       IF i IN menu.newMenu.mutualExclude THEN
  227.         WriteCard (mfile, i, 1);
  228.         Write (mfile, ",")
  229.         END
  230.       END;
  231.     IF menu.newMenu.mutualExclude # LONGSET {} THEN
  232.       SeekBack (mfile, 1)
  233.       END;
  234.     WriteString (mfile, "};");
  235.     WriteLn (mfile);
  236.  
  237.     IF menu.menuLabel[0] = 0C THEN
  238.       WriteString (mfile, "  userData      := NIL");
  239.       WriteLn (mfile)
  240.     ELSE
  241.       WriteString (mfile, "  userData      := ");
  242.       WriteString (mfile, projectName);
  243.       WriteString (mfile, "Menu");
  244.       WriteString (mfile, menu.menuLabel);
  245.       WriteString (mfile, "ID");
  246.       WriteLn (mfile)
  247.       END;
  248.  
  249.     WriteString (mfile, "  END;");
  250.     WriteLn (mfile)
  251.     END WriteNewMenuInit;
  252.  
  253.  
  254.   (* WriteMenuInit *)
  255.   BEGIN
  256.   menu := pw^.menus.head;
  257.   IF menu^.succ # NIL THEN
  258.     WriteLn (mfile);
  259.     WriteString (mfile, "PROCEDURE Init");
  260.     WriteString (mfile, pw^.name);
  261.     WriteString (mfile, "Menu;");
  262.     WriteLn (mfile);
  263.     WriteLn (mfile);
  264.  
  265.     WriteString (mfile, "BEGIN");
  266.     WriteLn (mfile);
  267.  
  268.  
  269.     i := 0;
  270.     menu := pw^.menus.head;
  271.     WHILE menu^.succ # NIL DO
  272.       INC (i);
  273.       WriteNewMenuInit (menu^, pw^.name, i);
  274.  
  275.       item := menu^.items^.head;
  276.       WHILE item^.succ # NIL DO
  277.         INC (i);
  278.         WriteNewMenuInit (item^, pw^.name, i);
  279.  
  280.         sub := item^.items^.head;
  281.         WHILE sub^.succ # NIL DO
  282.           INC (i);
  283.           WriteNewMenuInit (sub^, pw^.name, i);
  284.  
  285.           sub := sub^.succ
  286.           END;
  287.  
  288.         item := item^.succ;
  289.         END;
  290.  
  291.       menu := menu^.succ
  292.       END;
  293.  
  294.     WriteString (mfile, "WITH ");
  295.     WriteString (mfile, pw^.name);
  296.     WriteString (mfile, "Menu[");
  297.     WriteCard   (mfile, i+1, 3);
  298.     WriteString (mfile, "] DO");
  299.     WriteLn (mfile);
  300.  
  301.     WriteString (mfile, "  type          := nmEnd;");              WriteLn (mfile);
  302.     WriteString (mfile, "  label         := NIL;");                WriteLn (mfile);
  303.     WriteString (mfile, "  commKey       := NIL;");                WriteLn (mfile);
  304.     WriteString (mfile, "  itemFlags     := MenuItemFlagSet {};"); WriteLn (mfile);
  305.     WriteString (mfile, "  mutualExclude := LONGSET {};");         WriteLn (mfile);
  306.     WriteString (mfile, "  userData      := NIL");                 WriteLn (mfile);
  307.     WriteString (mfile, "  END");                                  WriteLn (mfile);
  308.  
  309.  
  310.     WriteString (mfile, "END Init");
  311.     WriteString (mfile, pw^.name);
  312.     WriteString (mfile, "Menu;");
  313.     WriteLn (mfile);
  314.     WriteLn (mfile)
  315.     END
  316.   END WriteMenuInit;
  317.  
  318.  
  319. (* WriteMenuProcs *)
  320. BEGIN
  321. WriteMenuInit (pw)
  322. END WriteMenuProcs;
  323.  
  324.  
  325.  
  326. PROCEDURE WriteMenuInits    (    pw            :ProjectWindowPtr);
  327.  
  328.  
  329. BEGIN
  330. IF pw^.menus.head^.succ # NIL THEN
  331.   WriteString (mfile, "Init");
  332.   WriteString (mfile, pw^.name);
  333.   WriteString (mfile, "Menu;");
  334.   WriteLn (mfile)
  335.   END
  336. END WriteMenuInits;
  337.  
  338.  
  339. END GenerateMenus.
  340.